Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-04/modula2f.zip/TEXT.MOD

Text File | 1992-05-01 | 7KB | 283 lines

IMPLEMENTATION MODULE Text;

FROM SYSTEM IMPORT ASSEMBLER;
FROM Strings IMPORT Length;

VAR atr,width,height:CARDINAL;

PROCEDURE Cls();
    BEGIN
        ASM
            XOR CX,CX
            MOV DL,width
            MOV DH,height
            MOV BH,atr
            XOR AL,AL
            MOV AH,6
            INT 10H
            XOR DX,DX
            XOR BH,BH
            MOV AH,2
            INT 10H
        END;
     END Cls;

PROCEDURE Color(fgc,bgc:CARDINAL);
    BEGIN
        atr:=(bgc MOD 8)*16+(fgc MOD 16);
    END Color;

PROCEDURE SetText();
    BEGIN
        ASM
            MOV AX,3
            INT 10H
        END;
        width := 79;
        height := 24;
    END SetText;

PROCEDURE SetEgaText();
    BEGIN
        ASM
            MOV AX,85
            INT 10H
        END;
        width := 131;
        height := 24;
    END SetEgaText;

PROCEDURE SetEga43();
    BEGIN
        ASM
            MOV AX,84
            INT 10H
        END;
        width := 131;
        height := 42;
    END SetEga43;

PROCEDURE SetCursor(v,h:CARDINAL);
    BEGIN
        IF v > height THEN
            v := height;
        END; (* if *)
        IF h > width THEN
            h := width;
        END; (* if *)
        ASM
            MOV DL,h
            MOV DH,v
            XOR BH,BH
            MOV AH,2
            INT 10H
        END;
    END SetCursor;

PROCEDURE GetKey(VAR ch,scan:CHAR);
    BEGIN
        ASM
            XOR AH,AH
            INT 16H
            LES DI,ch
            MOV ES:[DI],AL
            LES DI,scan
            MOV ES:[DI],AH
        END;
    END GetKey;

PROCEDURE Read(VAR ch:CHAR);
    VAR key,scan:CHAR;
    BEGIN
        GetKey(key,scan);
        Write(key);
        ch:=key;
    END Read;

PROCEDURE ReadCard(VAR n:CARDINAL);
    VAR str:ARRAY [0..5] OF CHAR;
          i:CARDINAL;
    BEGIN
        ReadString(str);
        n:=0;
        IF Length(str) > 0 THEN
            FOR i:=0 TO Length(str)-1 DO
                IF (str[i] >= '0') AND (str[i] <= '9') THEN
                    n:=10*n+(ORD(str[i])-ORD('0'));
                END; (* if *)
            END; (* for *)
       END; (* if *)
    END ReadCard;

PROCEDURE ReadInt(VAR i:INTEGER);
    VAR str:ARRAY [0..6] OF CHAR;
        c:CHAR;
        x:CARDINAL;
        p:INTEGER;
        neg:BOOLEAN;
    BEGIN
        ReadString(str);
        neg:=FALSE;
        i:=0; p:=0;
        IF Length(str) > 0 THEN
            x:=0;
            IF str[x] = "-" THEN
                neg:=TRUE; INC(x);
            END; (* if *)
            WHILE x < Length(str) DO
                IF (str[x] >= '0') AND (str[x] <= '9') THEN
                    p:=10*p; c:=str[x];
                    ASM
                        XOR AX,AX
                        MOV AL,c
                        SUB AX,48
                        ADD p,AX
                    END;
                    (* (ORD(str[x])-ORD('0')); *)
                END; (* if *)
                INC(x);
            END; (* while *)
        END; (* if *)
        IF neg THEN
            p:=-1*p;
        END; (* if *)
        i:=p;
    END ReadInt;

PROCEDURE ReadString(VAR str:ARRAY OF CHAR);
    VAR ch,sc:CHAR;
        i:CARDINAL;
    BEGIN
        i:=0;
        GetKey(ch,sc);
        WHILE ch<>CHR(13) DO
            IF (sc=CHR(14)) OR (sc=CHR(75)) THEN
                IF i>0 THEN
                    DEC(i);
                    ASM
                        MOV AL,8
                        MOV AH,14
                        INT 10H
                        MOV AL,32
                        MOV AH,14
                        INT 10H
                        MOV AL,8
                        MOV AH,14
                        INT 10H
                    END;
                END; (* if *)
            ELSE
                Write(ch);
                str[i]:=ch;
                INC(i);
            END; (* if *)
            GetKey(ch,sc);
        END; (* while *)
        str[i]:=CHR(0);
        WriteLn;
    END ReadString;

PROCEDURE WriteString(str:ARRAY OF CHAR);
    VAR i:CARDINAL;

    BEGIN
        IF Length(str) > 0 THEN
            FOR i:=0 TO Length(str)-1 DO
                Write(str[i]);
            END; (* for *)
        END; (* if *)
    END WriteString;

PROCEDURE WriteCard(n,lngth:CARDINAL);
    VAR buf:ARRAY [1..10] OF CHAR;
        ln:CARDINAL;
    BEGIN
        IF lngth > 10 THEN
            lngth:=10;
        END; (* if *)
        FOR ln:=1 TO 10 DO
            buf[ln]:=CHR(0);
        END; (* for *)
        ln:=lngth;
        buf[ln]:='0';
        WHILE (n>0) AND (ln>0) DO
            buf[ln]:=CHR((n MOD 10) + 48);
            n:=n DIV 10;
            DEC(ln);
        END; (* while *)
        FOR n:=1 TO lngth DO
            Write(buf[n]);
        END; (* for *)
    END WriteCard;

PROCEDURE WriteInt(n:INTEGER; lngth:CARDINAL);
    VAR buf:ARRAY [1..10] OF CHAR;
        ln,c:CARDINAL;
        neg:BOOLEAN;
    BEGIN
        IF lngth > 10 THEN
            lngth:=10;
        END; (* if *)
        FOR ln:=1 TO 10 DO
            buf[ln]:=CHR(0);
        END; (* for *)
        IF n<0 THEN
            neg:=TRUE;
            n:=-n;
        ELSE
            neg:=FALSE;
        END; (* if *)
            ASM
                MOV AX,n
                MOV c,AX
            END;
        ln:=lngth;
        buf[ln]:='0';
        WHILE (c>0) AND (ln>0) DO
            buf[ln]:=CHR((c MOD 10)+48);
            c:=c DIV 10;
            DEC(ln);
        END; (* while *)
        IF (ln>0) AND neg THEN
            buf[ln]:='-';
            DEC(ln);
        END; (* if *)
        FOR ln:=1 TO lngth DO
            Write(buf[ln]);
        END; (* for *)
    END WriteInt;

PROCEDURE Write(ch:CHAR);
    BEGIN
        ASM
            MOV CX,1
            MOV BL,atr
            XOR BH,BH
            MOV AL,ch
            MOV AH,9
            INT 10H
            MOV AH,3
            INT 10H
            INC DL
            MOV AH,2
            INT 10H
        END;
    END Write;

PROCEDURE WriteLn();
    BEGIN
        ASM
            MOV AL,10
            MOV AH,14
            INT 10H
            MOV AL,13
            MOV AH,14
            INT 10H
        END;
    END WriteLn;

BEGIN               (* initialization *)
    atr:=7;
    width:=79;
    height:=24;
END Text.